home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / visual < prev    next >
Encoding:
Tcl/Tk script  |  1997-08-15  |  3.1 KB  |  82 lines  |  [TEXT/ALFA]
  1. #!/usr/local/bin/wish -f
  2. #
  3. # This script displays provides visual tests for many of Tk's features.
  4. # Each test displays a window with various information in it, along
  5. # with instructions about how the window should appear.  You can look
  6. # at the window to make sure it appears as expected.  Individual tests
  7. # are kept in separate ".tcl" files in this directory.
  8. #
  9. # SCCS: @(#) visual 1.5 97/06/13 16:37:29
  10.  
  11. set auto_path ". $auto_path"
  12. wm title . "Visual Tests for Tk"
  13.  
  14. #-------------------------------------------------------
  15. # The code below create the main window, consisting of a
  16. # menu bar and a message explaining the basic operation
  17. # of the program.
  18. #-------------------------------------------------------
  19.  
  20. frame .menu -relief raised -borderwidth 1
  21. message .msg -font {Times 18} -relief raised -width 4i \
  22.     -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
  23.  
  24. pack .menu -side top -fill x
  25. pack .msg -side bottom -expand yes -fill both
  26.  
  27. #-------------------------------------------------------
  28. # The code below creates all the menus, which invoke procedures
  29. # to create particular demonstrations of various widgets.
  30. #-------------------------------------------------------
  31.  
  32. menubutton .menu.file -text "File" -menu .menu.file.m
  33. menu .menu.file.m
  34. .menu.file.m add command -label "Quit" -command exit
  35.  
  36. menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
  37. menu .menu.group1.m
  38. .menu.group1.m add command -label "Canvas arcs" -command {source arc.tcl}
  39. .menu.group1.m add command -label "Beveled borders in text widgets" \
  40.     -command {source bevel.tcl}
  41. .menu.group1.m add command -label "Colormap management" \
  42.     -command {source cmap.tcl}
  43. .menu.group1.m add command -label "Label/button geometry" \
  44.     -command {source butGeom.tcl}
  45. .menu.group1.m add command -label "Label/button colors" \
  46.     -command {source butGeom2.tcl}
  47.  
  48. menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
  49. menu .menu.ps.m
  50. .menu.ps.m add command -label "Rectangles and other graphics" \
  51.     -command {source canvPsGrph.tcl}
  52. .menu.ps.m add command -label "Text" \
  53.     -command {source canvPsText.tcl}
  54. .menu.ps.m add command -label "Bitmaps" \
  55.     -command {source canvPsBmap.tcl}
  56. .menu.ps.m add command -label "Arcs" \
  57.     -command {source canvPsArc.tcl}
  58.  
  59. pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
  60.  
  61. # Set up for keyboard-based menu traversal
  62.  
  63. bind . <Any-FocusIn> {
  64.     if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
  65.     focus .menu
  66.     }
  67. }
  68. tk_menuBar .menu .menu.file .menu.group1 .menu.ps
  69.  
  70. # The following procedure is invoked to print the contents of a canvas:
  71.  
  72. proc lpr c {
  73.     exec rm -f tmp.ps
  74.     $c postscript -file tmp.ps
  75.     exec lpr tmp.ps
  76. }
  77.  
  78. # Set up a class binding to allow objects to be deleted from a canvas
  79. # by clicking with mouse button 1:
  80.  
  81. bind Canvas <1> {%W delete [%W find closest %x %y]}
  82.